home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
COMAL
/
B-Book Series
/
(k)b5.d64
/
single file copy
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2007-02-28
|
4KB
|
167 lines
20 REM SINGLE DRIVE FILE COPY
40 POKE52,31:POKE56,31:CLR
45 FORI=0TO173
50 READ D:POKE7936+I,D:NEXT
55 POKE785,0:POKE786,31
60 PL$=CHR$(19)
65 FORI=1TO24:PL$=PL$+CHR$(17):NEXT
70 FORI=1TO39:CL$=CL$+" ":NEXT
75 CL$=CL$+CHR$(13)+CL$+CHR$(13)
80 CL$=LEFT$(PL$,21)+CL$+CHR$(145)+CHR$(145)
85 OPEN15,8,15:REM OPEN ERROR CHANNEL
90 GOTO1000
100 REM
110 REM READ THE DIRECTORY
130 POKE785,0:REM SELECT READ FUNCTION
140 PRINT#15,"I":OPEN2,8,2,"$"
150 NB=USR(2):REM LOAD DIR INTO MEM
160 CLOSE 2:GOSUB 800:REM CHECK ERROR
170 RETURN
200 REM
210 REM DISPLAY DISK NAME
230 POKE785,6:REMSELECT FETCH CHAR
240 PRINT LEFT$(PL$,3);CHR$(18);
250 FORK=142TO169
260 PRINT CHR$(USR(K));:NEXT
270 PRINT CHR$(146)
280 RETURN
300 REM
310 REM PRINT DIRECTORY ENTRY DE
330 POKE 785,6:REM SELECT FETCH CHAR
340 IX=(DE-1)*32+254-INT((DE-1)/8)*2
345 IF USR(IX)<128 THEN RETURN
350 TY=USR(IX)-128:IFTY=0ORTY>3THEN RETURN
360 FOR K=IX+3 TO IX +18
370 PRINT CHR$(USR(K));
380 NEXT:PRINT TAB(16);",";
390 PRINT MID$("SPU",TY,1):RETURN
400 REM
410 REM GET DESTINATION DISK
430 PRINT CL$;
440 PRINT "INSERT DESTINATION DISK"
450 PRINT"PRESS";CHR$(18);"RETURN";
460 PRINT CHR$(146);"WHEN READY."
470 GETDM$:IFDM$=""GOTO470
480 IFDM$<>CHR$(13)GOTO470
490 PRINT#15,"I":RETURN
500 REM
510 REM GET A FILE TO COPY
530 PRINT CL$;:IF EN=63 GOTO 580
540 IF UE=128THEN PRINT NM$;"TOO LARGE.";
550 IFEN=62 THEN PRINT NM$;"NOT FOUND.";
560 PRINT"ENTER FILE,TYPE":NM$="":EN=0:UE=0
570 INPUT NM$,TY$:RETURN
580 PRINT NM$;"EXISTS. ENTER NEW NAME"
590 EN=0:NM$="":INPUT NM$:RETURN
600 REM
610 REM READ THE FILE
630 POKE 785,0:REM SELECT READ FUNCTION
640 OPEN 2,8,2,NM$+","+TY$+",R"
650 GOSUB 900:IF EN<>0 THEN CLOSE 2:RETURN
660 NB=USR(2):REM READ THE FILE
670 CLOSE 2:GOSUB 800:REM CHECK RESULTS
680 RETURN
700 REM
710 REM WRITE THE FILE
730 POKE 785,3:REM SELECT WRITE FUNCTION
740 OPEN 2,8,2,NM$+","+TY$+",W"
750 GOSUB 900:IF EN<>0 THEN CLOSE 2:RETURN
760 NB=USR(2):REM WRITE THE BYTES
770 CLOSE 2:GOSUB 800:REM CHECK RESULTS
780 RETURN
800 REM
810 REM CHECK USR() RETURN VALUE
830 NB=NB-(NB<0)*65536
840 IF NB<61440 THEN UE =0:RETURN
850 IF NB=61440 THEN UE =128:RETURN
860 PRINT CL$;
870 IFPEEK(785)=0 THEN PRINT "READ";
880 IF PEEK(785)=3 THEN PRINT "WRITE";
890 PRINT "ERROR #";NB-61440:END
900 REM
910 REM READ ERROR CHANNEL
940 INPUT#15,EN,EM$,ET,ES
950 IF EN=0OREN=62OREN=63 THEN RETURN
960 CLOSE 15: PRINT CL$;
970 PRINT "DISK ERROR #";EN
980 PRINT LEFT$(PL$,22);EM$:END
1000 REM
1010 REM MAIN ROUTINE
1030 PRINT CHR$(147);:REM CLEAR SCREEN
1040 PRINT" SINGLE DRIVE FILE COPY"
1050 PRINT:PRINT "READING DIRECTORY"
1060 GOSUB 100:REM READ THE DIRECTORY
1070 GOSUB 200:REM DISPLAY THE TITLE
1080 NS=INT((NB+1)/254)
1090 IFNS=1 GOTO 5000:REM NO FILES
1100 DS=1
1110 IF NS<=DS THEN DS=1:REM START OVER
1120 PRINTLEFT$(PL$,4);
1130 BE=(DS-1)*8+1:LE=BE+15
1140 IFDS+1=NSTHEN LE=BE+8
1150 FOR DE= BE TO LE
1160 GOSUB 300:NEXT:REM DISPLAY FILES
1170 FORI=PEEK(214)TO20:REM CLEAR
1180 PRINT" "
1190 NEXT
1200 GOSUB 500:REM GET FILE NAME
1210 IF NM$="" THEN DS=DS+2:GOTO 1110
2010 REMCOPYTHE FILE
2030 PRINT CL$;
2040 PRINT"READING ";NM$
2050 GOSUB 600:REM READ THE FILE
2060 IF EN=62ORUE=128 GOTO 1200
2070 BC=NB:REM SAVE COUNT
2080 GOSUB 400:REM GET DEST DISK
2090 PRINT CL$;"WRITING ";NM$
2100 GOSUB 700:REM WRITE THE FILE
2110 IF EN=0 GOTO 3000
2120 GOSUB 500:REM GET NEW FILE
2130 IF NM$<>""GOTO 2090
2140 PRINT CL$;FILE NOT COPIED"
2150 [137] 3100
3000 [143]
3010 [143] DISPLAY COMPLETION STATUS
3030 [153] CL$;
3040 [139] NB[179][177]BC [137] 3060
3050 [153]"COPY SUCCESSFUL. ";:[137]3070
3060 [153]"ERROR ONLY ";NB;" OUT";
3070 [153] BC;"BYTES COPIED."
3100 [153] "PRESS";[199](18);
3110 [153]"RETURN";[199](146);
3120 [153]"TO COPY ANOTHER FILE"
3130 [161]DM$:[139]DM$[178]""[137]3130
3140 [139] DM$[178][199](13) [137] 1000
3150 [128]
4010 [143] NO FILES ERROR HANDLING
4030 [153] [200](PL$,21);
4040 [153]"NO FILES ON THIS DISK"
4050 [153]"PRESS RETURN TO TRY";
4060 [153] "ANOTHER DISK.";
4070 [161]DM$:[139] DM$[178]""[137]4070
4080 [139] DM$[178][199](13)[137] 1000
4090 [128]
5000 [143]
10000 [131]76,15,31,76,88,31,76,154
10010 [131]31,108,3,0,108,5,0,32
10020 [131]9,31,152,170,32,198,255,168
10030 [131]176,57,169,0,133,251,169,32
10040 [131]133,252,160,0,32,207,255,145
10050 [131]251,230,251,208,2,230,252,165
10060 [131]144,208,13,165,252,201,160,144
10070 [131] 235,32,204,255,160,0,240,19
10080 [131]164,144,32,204,255,192,64,208
10090 [131]10,164,251,165,252,56,233,32
10100 [131] 76,12,31,169,240,76,12,31
10110 [131]32,9,31,152,170,32,201,255
10120 [131]168,176,240,165,251,141,174,31
10130 [131]165,252,141,175,31,169,0,133
10140 [131]251,169,32,133,252,160,0,177
10150 [131]251,32,210,255,164,144,208,20
10160 [131]230,251,208,2,230,252,165,252
10170 [131]205,175,31,144,234,165,251,205
10180 [131]174,31,144,227,32,204,255,76
10190 [131]73,31,32,9,31,132,251,24
10200 [131]105,32,133,252,160,0,177,251
10210 [131]168,169,0,76,12,31